Na potrzeby projektu użyłam danych pochodzących ze strony Głównego
Urzędu Statystycznego.
Dane te dotyczą przeciętnego miesięcznego wynagrodzenia brutto w
sektorze przedsiębiorstw. W pobranym pliku .xlsx zaprezentowano średnie
wynagrodzenie brutto ogółem, ale i osobno dla każdego sektora. Do
przeprowadzenia dalszych analiz wybrałam trzy kolumny (cechy):
1. dotycząca ogółu wszystkich sektorów,
2. dotycząca sektora informacji/komunikacji,
3. dotycząca sektora budownictwa.
summary(cars)
## speed dist
## Min. : 4.0 Min. : 2.00
## 1st Qu.:12.0 1st Qu.: 26.00
## Median :15.0 Median : 36.00
## Mean :15.4 Mean : 42.98
## 3rd Qu.:19.0 3rd Qu.: 56.00
## Max. :25.0 Max. :120.00
setwd("C:/Users/marty/Desktop/GITHUB/statad")
Dane zostały wczytane przy użyciu pakietu do wczytywania tabeli z pliku Excela. Następnie je uporządkowałam, tzn. usunęłam niepotrzebne wiersze oraz kolumny wypełnione wartościami NULL. Powstałej w ten sposób ramce danych nadałam nowe nazwy wierszy i kolumn.
#install.packages("readxl")
library("readxl")
zarobki <- read_excel("tabl19.xlsx")
## New names:
## • `` -> `...2`
## • `` -> `...3`
## • `` -> `...4`
## • `` -> `...5`
## • `` -> `...6`
## • `` -> `...7`
## • `` -> `...8`
## • `` -> `...9`
## • `` -> `...10`
## • `` -> `...11`
## • `` -> `...12`
## • `` -> `...13`
## • `` -> `...14`
## • `` -> `...15`
## • `` -> `...16`
## • `` -> `...17`
## • `` -> `...18`
## • `` -> `...19`
## • `` -> `...20`
## • `` -> `...21`
## • `` -> `...22`
## • `` -> `...23`
## • `` -> `...24`
## • `` -> `...25`
## • `` -> `...26`
## • `` -> `...27`
## • `` -> `...28`
## • `` -> `...29`
## • `` -> `...30`
## • `` -> `...31`
## • `` -> `...32`
## • `` -> `...33`
## • `` -> `...34`
## • `` -> `...35`
## • `` -> `...36`
## • `` -> `...37`
## • `` -> `...38`
## • `` -> `...39`
## • `` -> `...40`
## • `` -> `...41`
## • `` -> `...42`
## • `` -> `...43`
## • `` -> `...44`
## • `` -> `...45`
## • `` -> `...46`
## • `` -> `...47`
## • `` -> `...48`
## • `` -> `...49`
## • `` -> `...50`
## • `` -> `...51`
## • `` -> `...52`
## • `` -> `...53`
## • `` -> `...54`
## • `` -> `...55`
## • `` -> `...56`
## • `` -> `...57`
## • `` -> `...58`
## • `` -> `...59`
## • `` -> `...60`
## • `` -> `...61`
## • `` -> `...62`
## • `` -> `...63`
## • `` -> `...64`
## • `` -> `...65`
## • `` -> `...66`
## • `` -> `...67`
## • `` -> `...68`
## • `` -> `...69`
## • `` -> `...70`
## • `` -> `...71`
## • `` -> `...72`
## • `` -> `...73`
## • `` -> `...74`
## • `` -> `...75`
## • `` -> `...76`
## • `` -> `...77`
## • `` -> `...78`
## • `` -> `...79`
## • `` -> `...80`
## • `` -> `...81`
## • `` -> `...82`
## • `` -> `...83`
## • `` -> `...84`
## • `` -> `...85`
## • `` -> `...86`
## • `` -> `...87`
## • `` -> `...88`
## • `` -> `...89`
## • `` -> `...90`
## • `` -> `...91`
## • `` -> `...92`
## • `` -> `...93`
str(zarobki)
zarobki <- as.data.frame(zarobki)
zarobki <- zarobki[-(c(1,2,3,5)),]
#Utworzenie wektora liczb odpowiadających kolumnom które mają zotać usunięte
#Począwszy od 3 kolumny, co druga zawiera same wartości NULL
colrm <- seq(from = 3, to = 93, by = 2)
colrm <- as.vector(colrm)
zarobki <- zarobki[,-colrm] #pełna tabela
#cn <- as.vector(zarobki[1,])
#cn[1] <- "Okres"
#cn[2] <- "Ogolem"
#cn[3] <- "Informacja/komunikacja"
#cn[4] <- "Budownictwo"
#Uporządkowanie nazw ramki danych
#colnames(zarobki) <- cn
zarobki <- zarobki[-1,]
rownames(zarobki) <- seq(from = 1, to = 158, by = 1)
#zarobki <- zarobki[,-1]
#zarobki$rok <- as.integer(substr(zarobki[,1], 1, 4))
zarobki1 <- zarobki[,c(1,2,45,33)] #tabela z wybranymi kolumnami, na których przeprowadzono obliczenia
zarobki1$rok <- as.integer(substr(zarobki[,1], 1, 4))
colnames(zarobki1) <- c("Okres", "Ogółem", "Informacja/komunikacja", "Budownictwo", "rok")
Po wstępnej obróbce ramka danych zawierająca pożądane dane prezentuje się tak
zarobki1[1:10,1:4]
## Okres Ogółem Informacja/komunikacja Budownictwo
## 1 2010 M01 3231.13 5932.17 3274.29
## 2 2010 M02 3288.29 6082.19 3222.95
## 3 2010 M03 3493.42 7037.23 3533.39
## 4 2010 M04 3398.67 6096.44 3523.25
## 5 2010 M05 3346.61 6111.69 3465.56
## 6 2010 M06 3403.65 5845.3 3557.29
## 7 2010 M07 3433.32 6054.03 3583.07
## 8 2010 M08 3407.26 6188.29 3651.63
## 9 2010 M09 3403.68 6102.07 3592.8
## 10 2010 M10 3440.22 6181.99 3556.31
Na podstawie ramki danych zarobki1 obliczyłam 8 parametrów statystyki opisowej dla każdej kolumny, w tym: średnią, odchylenie standardowe, medianę, współczynnik zmienności, wariancję, dominantę, kurtozę i skośność. Jednak by takie obliczenia były możliwe, wcześniej użyłam funkcji as.double(), aby nadać wartościom w ramce danych odpowiedni typ (double).
#zamiana wierszy z zarobkami na strukturę DOUBLE by można było na nich wykonać obliczenia
zarobki1[,2] <- as.double(zarobki1[,2])
zarobki1[,3] <- as.double(zarobki1[,3])
zarobki1[,4] <- as.double(zarobki1[,4])
#1.średnia
srednia1 <- mean(zarobki1[,2])
srednia2 <- mean(zarobki1[,3])
srednia3 <- mean(zarobki1[,4])
#2.odchylenie standardowe
ochdst1 <- sd(zarobki1[,2])
ochdst2 <- sd(zarobki1[,3])
ochdst3 <- sd(zarobki1[,4])
#3.mediana
mediana1 <- quantile(zarobki1[,2])
mediana1 <- mediana1[3]
mediana2 <- quantile(zarobki1[,3])
mediana2 <- mediana2[3]
mediana2
## 50%
## 7550.26
mediana3 <- quantile(zarobki1[,4])
mediana3 <- mediana3[3]
mediana3
## 50%
## 4232.66
#4.współczynnik zmienności
wsp1 <- ochdst1/srednia1*100
wsp2<- ochdst2/srednia2
wsp3 <- ochdst3/srednia3
#Współczynnik zmienności:
#poniżej 25 proc. – bardzo mała zmienność,
#w granicach od 25 do 45 proc. – przeciętna zmienność,
#w granicach od 45 do 100 proc. – silna zmienność,
#powyżej 100 proc. – bardzo intensywna zmienność
#5.wariancja
war1 <- var(zarobki1[,2])
war2 <- var(zarobki1[,3])
war3 <- var(zarobki1[,4])
#6.dominanta
getmode <- function(v) {
uniqv <- unique(v)
uniqv[which.max(tabulate(match(v, uniqv)))]
}
dom1 <- getmode(zarobki1[,2])
dom2 <- getmode(zarobki1[,3])
dom3 <- getmode(zarobki1[,4])
Do obliczenia kurtozy i skośności użyłam funkcji kurtosis() i skewness() z biblioteki “moments”.
#Instalacja pakietu moments do obliczenia kurtozy i skośności
#install.packages("moments")
library("moments")
#7.kurtoza
k1 <- kurtosis(zarobki1[,2])
k2 <- kurtosis(zarobki1[,3])
k3 <- kurtosis(zarobki1[,4])
#8.skośność
sk1 <- skewness(zarobki1[,2])
sk2 <- skewness(zarobki1[,3])
sk3 <- skewness(zarobki1[,4])
Następnie stworzyłam ramkę danych zawierającą obliczone wyżej parametry.
param <- data.frame("średnia" = c(srednia1,srednia2,srednia3), "odchylenie standardowe"=c(ochdst1,ochdst2,ochdst3), "mediana"=c(mediana1,mediana2,mediana3),"współczynnik zmienności[%]"=c(wsp1,wsp2,wsp3), "wariancja"=c(war1,war2,war3), "dominanta"=c(dom1,dom2,dom3), "kurtoza"=c(k1,k2,k3), "skośność"=c(sk1,sk2,sk3))
rownames(param) <- c("zarobki ogółem", "informacja/komunikacja", "budownictwo")
param
## średnia odchylenie.standardowe mediana
## zarobki ogółem 4593.923 978.9531 4298.40
## informacja/komunikacja 7979.005 1583.6595 7550.26
## budownictwo 4553.208 938.0098 4232.66
## współczynnik.zmienności... wariancja dominanta kurtoza
## zarobki ogółem 21.3097432 958349.2 3231.13 2.801419
## informacja/komunikacja 0.1984783 2507977.5 5932.17 2.862943
## budownictwo 0.2060107 879862.3 3274.29 2.505300
## skośność
## zarobki ogółem 0.8283975
## informacja/komunikacja 0.8571349
## budownictwo 0.7569491
Patrząc na powyższą tabelę łatwo wysnuć wniosek, iż:
a. średnie wynagrodzenie brutto w sektorze budownictwa nie odbiega mocno
od średniego wynagrodzenia dla ogółu sektorów,
b. średnie wynagrodzenie dla sektora informacji/komunikacji znacznie je
przewyższa.
Sporządziłam kilka wykresów, prezentujących dane. Poniżej znajdują się dwa histogramy. Umożliwiają one porównanie wynagrodzenia w sektorach informacji i budownictwa z tym ogólnym średnim wynagrodzeniem.
par(mfrow=c(2,1))
par(mar=c(0,5,3,3))
hist(zarobki1[,2], main="" , xlim=c(3000,13000), ylab="Ogółem", xlab="", ylim=c(0,50) , xaxt="n", las=1 , col="slateblue1", breaks=10)
par(mar=c(5,5,0,3))
hist(zarobki1[,3], main="" , xlim=c(3000,13000), ylab="informacja/komunikacja", xlab="Wysokość wynagrodzenia", ylim=c(50,0) , las=1 , col="yellow" , breaks=10)
par(mfrow=c(2,1))
par(mar=c(0,5,3,3))
hist(zarobki1[,2] , main="" , xlim=c(3000,10000), ylab="Ogółem", xlab="", ylim=c(0,60) , xaxt="n", las=1 , col="slateblue1", breaks=10)
par(mar=c(5,5,0,3))
hist(zarobki1[,4] , main="" , xlim=c(3000,10000), ylab="budownictwo", xlab="Wysokość wynagrodzenia", ylim=c(60,0) , las=1 , col="purple" , breaks=10)
Średnie zarobki dla wszystkich cech zostały również zobrazowane na wykresie pudełkowym.
#boxplot
boxplot(zarobki1[,2:4],col='pink')
Sporządziłam także wykres dystrybuanty empirycznej wysokości
wynagrodzenia (Ogółem). Funkcja ecdf() wyświetla punkty skokowe.
ecdf(zarobki1[,2]) #funkcja wyświetlająca punkty skokowe na "surowych" danych
## Empirical CDF
## Call: ecdf(zarobki1[, 2])
## x[1:158] = 3231.1, 3288.3, 3346.6, ..., 7065.6, 7330
#Pogrupowanie danych w celu zmniejszenia liczby punktów skokowych poprzez podział wartości na klasy
ilosc_klas = 11
klasy = seq(min(zarobki1[,2])-50, max(zarobki1[,2]), length.out = ilosc_klas+1)
klasy <- round(klasy,digits=1)
klasy
## [1] 3181.1 3558.3 3935.5 4312.6 4689.8 5067.0 5444.1 5821.3 6198.5 6575.6
## [11] 6952.8 7330.0
klasy_srodki = round((klasy[-length(klasy)] + klasy[-1])/2, 1)
klasy_srodki
## [1] 3369.7 3746.9 4124.0 4501.2 4878.4 5255.6 5632.7 6009.9 6387.0 6764.2
## [11] 7141.4
cut(zarobki1[,2],klasy, dig.lab=10)
## [1] (3181.1,3558.3] (3181.1,3558.3] (3181.1,3558.3] (3181.1,3558.3]
## [5] (3181.1,3558.3] (3181.1,3558.3] (3181.1,3558.3] (3181.1,3558.3]
## [9] (3181.1,3558.3] (3181.1,3558.3] (3181.1,3558.3] (3558.3,3935.5]
## [13] (3181.1,3558.3] (3181.1,3558.3] (3558.3,3935.5] (3558.3,3935.5]
## [17] (3181.1,3558.3] (3558.3,3935.5] (3558.3,3935.5] (3558.3,3935.5]
## [21] (3558.3,3935.5] (3558.3,3935.5] (3558.3,3935.5] (3935.5,4312.6]
## [25] (3558.3,3935.5] (3558.3,3935.5] (3558.3,3935.5] (3558.3,3935.5]
## [29] (3558.3,3935.5] (3558.3,3935.5] (3558.3,3935.5] (3558.3,3935.5]
## [33] (3558.3,3935.5] (3558.3,3935.5] (3558.3,3935.5] (3935.5,4312.6]
## [37] (3558.3,3935.5] (3558.3,3935.5] (3558.3,3935.5] (3558.3,3935.5]
## [41] (3558.3,3935.5] (3558.3,3935.5] (3558.3,3935.5] (3558.3,3935.5]
## [45] (3558.3,3935.5] (3558.3,3935.5] (3558.3,3935.5] (3935.5,4312.6]
## [49] (3558.3,3935.5] (3558.3,3935.5] (3935.5,4312.6] (3935.5,4312.6]
## [53] (3558.3,3935.5] (3935.5,4312.6] (3935.5,4312.6] (3558.3,3935.5]
## [57] (3558.3,3935.5] (3935.5,4312.6] (3935.5,4312.6] (4312.6,4689.8]
## [61] (3935.5,4312.6] (3935.5,4312.6] (3935.5,4312.6] (3935.5,4312.6]
## [65] (3935.5,4312.6] (3935.5,4312.6] (3935.5,4312.6] (3935.5,4312.6]
## [69] (3935.5,4312.6] (3935.5,4312.6] (3935.5,4312.6] (4312.6,4689.8]
## [73] (3935.5,4312.6] (3935.5,4312.6] (4312.6,4689.8] (4312.6,4689.8]
## [77] (3935.5,4312.6] (3935.5,4312.6] (3935.5,4312.6] (3935.5,4312.6]
## [81] (3935.5,4312.6] (3935.5,4312.6] (4312.6,4689.8] (4312.6,4689.8]
## [85] (3935.5,4312.6] (3935.5,4312.6] (4312.6,4689.8] (4312.6,4689.8]
## [89] (4312.6,4689.8] (4312.6,4689.8] (4312.6,4689.8] (4312.6,4689.8]
## [93] (4312.6,4689.8] (4312.6,4689.8] (4312.6,4689.8] (4689.8,5067]
## [97] (4312.6,4689.8] (4312.6,4689.8] (4689.8,5067] (4689.8,5067]
## [101] (4689.8,5067] (4689.8,5067] (4689.8,5067] (4689.8,5067]
## [105] (4689.8,5067] (4689.8,5067] (4689.8,5067] (5067,5444.1]
## [109] (4689.8,5067] (4689.8,5067] (5067,5444.1] (5067,5444.1]
## [113] (4689.8,5067] (5067,5444.1] (5067,5444.1] (5067,5444.1]
## [117] (5067,5444.1] (5067,5444.1] (5067,5444.1] (5444.1,5821.3]
## [121] (5067,5444.1] (5067,5444.1] (5444.1,5821.3] (5067,5444.1]
## [125] (5067,5444.1] (5067,5444.1] (5067,5444.1] (5067,5444.1]
## [129] (5067,5444.1] (5444.1,5821.3] (5444.1,5821.3] (5821.3,6198.5]
## [133] (5444.1,5821.3] (5444.1,5821.3] (5821.3,6198.5] (5444.1,5821.3]
## [137] (5444.1,5821.3] (5444.1,5821.3] (5821.3,6198.5] (5821.3,6198.5]
## [141] (5821.3,6198.5] (5821.3,6198.5] (5821.3,6198.5] (6575.6,6952.8]
## [145] (5821.3,6198.5] (6198.5,6575.6] (6575.6,6952.8] (6575.6,6952.8]
## [149] (6198.5,6575.6] (6198.5,6575.6] (6575.6,6952.8] (6575.6,6952.8]
## [153] (6575.6,6952.8] (6575.6,6952.8] (6575.6,6952.8] (6952.8,7330]
## [157] (6575.6,6952.8] (6952.8,7330]
## 11 Levels: (3181.1,3558.3] (3558.3,3935.5] (3935.5,4312.6] ... (6952.8,7330]
przedzialy <- table(cut(zarobki1[,2],klasy,dig.lab=10))
przedzialy
##
## (3181.1,3558.3] (3558.3,3935.5] (3935.5,4312.6] (4312.6,4689.8] (4689.8,5067]
## 14 36 30 17 13
## (5067,5444.1] (5444.1,5821.3] (5821.3,6198.5] (6198.5,6575.6] (6575.6,6952.8]
## 17 9 8 3 9
## (6952.8,7330]
## 2
#Dystrybuanta empiryczna na pogrupowanych danych
ecdf(cut(zarobki1[,2],klasy, dig.lab=10))
## Empirical CDF
## Call: ecdf(cut(zarobki1[, 2], klasy, dig.lab = 10))
## x[1:11] = 1, 2, 3, ..., 10, 11
ecdf(cut(zarobki1[,2],klasy, dig.lab=10))(1:ilosc_klas)
## [1] 0.08860759 0.31645570 0.50632911 0.61392405 0.69620253 0.80379747
## [7] 0.86075949 0.91139241 0.93037975 0.98734177 1.00000000
srodki_czestosci <- data.frame("środki klas"=klasy_srodki, "częstości skumulowane"=ecdf(cut(zarobki1[,2],klasy, dig.lab=10))(1:ilosc_klas))
srodki_czestosci
## środki.klas częstości.skumulowane
## 1 3369.7 0.08860759
## 2 3746.9 0.31645570
## 3 4124.0 0.50632911
## 4 4501.2 0.61392405
## 5 4878.4 0.69620253
## 6 5255.6 0.80379747
## 7 5632.7 0.86075949
## 8 6009.9 0.91139241
## 9 6387.0 0.93037975
## 10 6764.2 0.98734177
## 11 7141.4 1.00000000
plot(ecdf(cut(zarobki1[,2],klasy, dig.lab=10)), col="orange", col.lab="red", col.main="red",
xlab="Zarobki", ylab="Łączna częstość", main="Dystrybuanta wysokości zarobków (ogółem)", lwd=2, xaxt="n", las=1)
axis(side=1, at=1:ilosc_klas, labels=klasy_srodki)
Kolejnym sporządzonym przeze mnie wykresem jest interaktywny wykres
prezentujący zmiany średnich zarobków na przestrzeni lat. Po najechaniu
myszką na wykres, pojawiają się szczegółowe informacje. Do stworzenia
tego wykresu użyłam pakietów dplyr, tidyverse oraz plotly.
#install.packages("dplyr") #bez tego pakietu funkcja %>% nie działa
#install.packages("tidyverse")
#installed.packages("plotly")
library(dplyr)
##
## Dołączanie pakietu: 'dplyr'
## Następujące obiekty zostały zakryte z 'package:stats':
##
## filter, lag
## Następujące obiekty zostały zakryte z 'package:base':
##
## intersect, setdiff, setequal, union
library(tidyverse)
## ── Attaching core tidyverse packages ──────────────────────── tidyverse 2.0.0 ──
## ✔ forcats 1.0.0 ✔ readr 2.1.4
## ✔ ggplot2 3.4.1 ✔ stringr 1.5.0
## ✔ lubridate 1.9.2 ✔ tibble 3.2.1
## ✔ purrr 1.0.1 ✔ tidyr 1.3.0
## ── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
## ✖ dplyr::filter() masks stats::filter()
## ✖ dplyr::lag() masks stats::lag()
## ℹ Use the conflicted package (<http://conflicted.r-lib.org/>) to force all conflicts to become errors
library(plotly)
##
## Dołączanie pakietu: 'plotly'
##
## Następujący obiekt został zakryty z 'package:ggplot2':
##
## last_plot
##
## Następujący obiekt został zakryty z 'package:stats':
##
## filter
##
## Następujący obiekt został zakryty z 'package:graphics':
##
## layout
p <- (zarobki1) %>%
group_by(rok) %>%
mutate(srednia = mean(as.numeric(Ogółem), na.rm = T)) %>%
slice(1) %>%
ungroup() %>%
ggplot(aes(x = rok)) +
geom_point(aes(y = srednia), color="#FCB13B") +
geom_line(aes(y = srednia), color="#FCB13B") +
theme(axis.text.x = element_text(angle = 0, vjust = 0.5, hjust=1)) +
ggtitle("Średnie wynagrodzenie brutto na przestrzeni lat 2010-2023") +
labs(x="Rok", y="Wynagrodzenie")
ggplotly(p)
Przy użyciu funkcji t.test oraz var.test zweryfikowałam dwa typy
hipotez statystycznych dla kolumny “Ogółem”. W pierwszym typie
zakładamy:
H0: Średnia wysokość wynagrodzenia (zarobki1\(Ogolem) wynosi 4500\
H1: Średnia wysokość wynagrodzenia (zarobki1\)Ogolem) nie wynosi
4500
t.test(zarobki1[,2], mu=4500)
##
## One Sample t-test
##
## data: zarobki1[, 2]
## t = 1.206, df = 157, p-value = 0.2296
## alternative hypothesis: true mean is not equal to 4500
## 95 percent confidence interval:
## 4440.092 4747.753
## sample estimates:
## mean of x
## 4593.923
Ponieważ p-value > 1-0.95(confidence_level), nie ma podstaw do odrzucenia H0.
Dla drugiego typu:
#Hipoteza dla wariancji (zarobki ogółem) var.test(zarobki1, zarobki1[,3], mu=5000)